home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / ARCHIVES.SWG / 0002_Display Archive Files.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  9KB  |  268 lines
  1. {
  2.    Hmmmm, I thought I responded to you on this before.  Whether I did or
  3. not, I will post what I did before (in the next two messages), but I
  4. don't want to post the entire Program - I'm building a ShareWare
  5. progream I plan to market, and I don't think I should give it _all_
  6. away.  The code I post is pertinent to reading the headers and Filename
  7. info in the Various archive Types, and I Really think you can work out
  8. the rest without much trouble.  If you can't, please post a specific
  9. question...
  10. }
  11.  
  12. Const
  13.       BSize    = 4096;                                      { I/O Buffer Size }
  14.       HMax     = 512;                                   { Header Maximum Size }
  15. Var
  16.       I,J,K        : Integer;
  17.       CT,RC,TC     : Integer;
  18.       RES          : Word;                                   { Buffer Residue }
  19.       N,P,Q        : LongInt;
  20.       C            : LongInt;                                 { Buffer Offset }
  21.       FSize        : LongInt;                                     { File Size }
  22.       DEVICE       : Char;                                      { Disk Device }
  23.       F            : File;
  24.       SNAME        : String;
  25.       DATE         : String[8];                  { formatted date as YY/MM/DD }
  26.       TIME         : String[5];                  {     "     time as HH:MM    }
  27.       DirInfo      : SearchRec;                       { File name search Type }
  28.       SR           : SearchRec;                       { File name search Type }
  29.       DT           : DateTime;
  30.       PATH         : PathStr;
  31.       DIR          : DirStr;
  32.       FNAME        : NameStr;
  33.       EXT          : ExtStr;
  34.       Regs         : Registers;
  35.       BUFF         : Array[1..BSize] of Byte;
  36.  
  37. Procedure FDT (LI : LongInt);                       { Format Date/Time fields }
  38. begin
  39.   UnPackTime (LI,DT);
  40.   DATE := FSI(DT.Month,2)+'/'+FSI(DT.Day,2)+'/'+Copy(FSI(DT.Year,4),3,2);
  41.   if DATE[4] = ' ' then DATE[4] := '0';
  42.   if DATE[7] = ' ' then DATE[7] := '0';
  43.   TIME := FSI(DT.Hour,2)+':'+FSI(DT.Min,2);
  44.   if TIME[4] = ' ' then TIME[4] := '0';
  45. end;  { FDT }
  46.  
  47. Procedure  MY_FFF;
  48. Var I,J,K : LongInt;
  49.  
  50. (**************************** ARJ Files Processing ***************************)
  51. Type ARJHead = Record
  52.                  FHeadSize : Byte;
  53.                  ArcVer1,
  54.                  ArcVer2   : Byte;
  55.                  HostOS,
  56.                  ARJFlags,
  57.                  Method    : Byte;   { MethodType = (Stored, LZMost, LZFast); }
  58.                  R1,R2     : Byte;
  59.                  Dos_DT    : LongInt;
  60.                  CompSize,
  61.                  UCompSize,
  62.                  CRC       : LongInt;
  63.                  ENP, FM,
  64.                  HostData  : Word;
  65.                end;
  66. Var ARJ1     : ARJHead;
  67.     ARJId    : Word;                                     { 60000, if ARJ File }
  68.     HSize    : Word;                                            { Header Size }
  69. Procedure GET_ARJ_ENTRY;
  70. begin
  71.   FillChar(ARJ1,SizeOf(ARJHead),#0); FillChar(BUFF,BSize,#0);
  72.   Seek (F,C-1); BlockRead(F,BUFF,BSIZE,RES);        { read header into buffer }
  73.   Move (BUFF[1],ARJId,2);  Move (BUFF[3],HSize,2);
  74.   if HSize > 0 then
  75.     With ARJ1 do
  76.       begin
  77.         Move (BUFF[5],ARJ1,SizeOf(ARJHead));
  78.         I := FHeadSize+5; SNAME := B40;
  79.         While BUFF[I] > 0 do Inc (I);
  80.         I := I-FHeadSize-5;
  81.         Move (BUFF[FHeadSize+5],SNAME[1],I); SNAME[0] := Chr(I);
  82.         FSize := CompSize; Inc (C,HSIZE);
  83.       end;
  84. end;  { GET_ARJ_ENTRY }
  85.  
  86. Procedure DO_ARJ (FN : String);
  87. begin
  88.   Assign (F,FN); Reset (F,1); C := 1;
  89.   GET_ARJ_ENTRY;                                            { Process File
  90. Header }
  91.   Repeat
  92.     Inc(C,FSize+10);
  93.     GET_ARJ_ENTRY;
  94.     if HSize > 0 then
  95.       begin
  96.         Inc (WPX); New(SW[WPX]);       { store Filename info in dynamic Array }
  97.         With SW[WPX]^ do
  98.           begin
  99.             FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+'    ',1,4)
  100.             SIZE := ARJ1.UCompSize;
  101.             RType := 4; D_T := ARJ1.Dos_DT; ANUM := ADX; VNUM := VDX;
  102.             ADD_CNAME;
  103.           end;
  104.         Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)
  105.       end;
  106.   Until HSize <= 0;
  107.   Close (F);
  108. end;  { DO_ARJ }
  109.  
  110. (**************************** ZIP Files Processing ***************************)
  111. Type ZIPHead = Record
  112.                  ExtVer : Word;
  113.                  Flags  : Word;
  114.                  Method : Word;
  115.                  Fill1  : Word;
  116.                  Dos_DT        : LongInt;
  117.                  CRC32         : LongInt;
  118.                  CompSize      : LongInt;
  119.                  UCompSize     : LongInt;
  120.                  FileNameLen   : Word;
  121.                  ExtraFieldLen : Word;
  122.                end;
  123. Var ZIPCSize : LongInt;
  124.     ZIPId    : Word;
  125.     ZIP1     : ZIPHead;
  126. Procedure GET_ZIP_ENTRY;
  127. begin
  128.   FillChar(ZIP1,SizeOf(ZIPHead),#0); Move (BUFF[C+1],ZIPId,2);
  129.   if ZIPId > 0 then
  130.     begin
  131.       Move (BUFF[C+1],ZIP1,SizeOf(ZIPHead));
  132.       Inc (C,43); SNAME := '';
  133.       With ZIP1 do
  134.         begin
  135.           Move (BUFF[C],SNAME[1],FileNameLen); SNAME[0] := Chr(FileNameLen);
  136.           FSize := CompSize;
  137.         end;
  138.     end;
  139. end;  { GET_ZIP_ENTRY }
  140.  
  141. Procedure DO_ZIP (FN : String);
  142. Const CFHS : String[4] = 'PK'#01#02;          { CENTRAL_File_HEADER_SIGNATURE }
  143.       ECDS : String[4] = 'PK'#05#06;        { end_CENTRAL_DIRECTORY_SIGNATURE }
  144. Var S4     : String[4];
  145.     FOUND  : Boolean;
  146.     QUIT   : Boolean;                            { "end" sentinel encountered }
  147. begin
  148. --- GOMail v1.1 [DEMO] 03-09-93
  149.  * Origin: The Private Reserve - Phoenix, AZ (602) 997-9323 (1:114/151)
  150. <<<>>>
  151.  
  152.  
  153. Date: 03-23-93 (22:30)              Number: 16806 of 16859 (Echo)
  154.   To: EDDIE BRAITER                 Refer#: NONE
  155. From: MIKE COPELAND                   Read: NO
  156. Subj: FORMAT VIEWER - PART 2 of     Status: PUBLIC MESSAGE
  157. Conf: F-PASCAL (1221)            Read Type: GENERAL (+)
  158.  
  159. (**************************** ARC Files Processing ***************************)
  160. Type ARCHead = Record
  161.                  ARCMark   : Char;
  162.                  ARCVer    : Byte;
  163.                  FN        : Array[1..13] of Char;
  164.                  CompSize  : LongInt;
  165.                  Dos_DT    : LongInt;
  166.                  CRC       : Word;
  167.                  UCompSize : LongInt;
  168.                end;
  169. Const ARCFlag : Char = #26;                                        { ARC mark }
  170. Var WLV   : LongInt;                               { Working LongInt Variable }
  171.     ARC1  : ARCHead;
  172.     QUIT  : Boolean;                             { "end" sentinel encountered }
  173.  
  174. Procedure GET_ARC_ENTRY;
  175. begin
  176.   FillChar(ARC1,SizeOf(ARCHead),#0); L := SizeOf(ARCHead);
  177.   Seek (F,C); BlockRead (F,BUFF,L,RES);
  178.   Move (BUFF[1],ARC1,L);
  179.   With ARC1 do
  180.     if (ARCMark = ARCFlag) and (ARCVer > 0) then
  181.       begin
  182.         SNAME := ''; I := 1;
  183.         While FN[I] <> #0 do
  184.           begin
  185.             SNAME := SNAME+FN[I]; Inc(I)
  186.           end;
  187.         WLV := (Dos_DT Shr 16)+(Dos_DT Shl 16);              { flip Date/Time }
  188.         FSize := CompSize;
  189.       end;
  190.     QUIT := ARC1.ARCVer <= 0;
  191. end;  { GET_ARC_ENTRY }
  192.  
  193. Procedure DO_ARC (FN : String);
  194. begin
  195.   Assign (F,FN); Reset (F,1); C := 0;
  196.   Repeat
  197.     GET_ARC_ENTRY;
  198.     if not QUIT then
  199.       begin
  200.         Inc (WPX); New(SW[WPX]);       { store Filename info in dynamic Array }
  201.         With SW[WPX]^ do
  202.           begin
  203.             FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+'    ',1,4)
  204.             SIZE := ARC1.UCompSize; RType := 4;                   { comp File }
  205.             D_T := WLV; ANUM := ADX; VNUM := VDX;
  206.             ADD_CNAME;
  207.           end;
  208.         Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)
  209.       end;
  210.     Inc (C,FSize+SizeOf(ARCHead))
  211.   Until QUIT;
  212.   Close (F);
  213. end;  { DO_ARC }
  214.  
  215. (************************* LZH Files Processing ******************************)
  216. Type LZHHead = Record
  217.                  HSize       : Byte;
  218.                  Fill1       : Byte;
  219.                  Method      : Array[1..5] of Char;
  220.                  CompSize    : LongInt;
  221.                  UCompSize   : LongInt;
  222.                  Dos_DT      : LongInt;
  223.                  Fill2       : Word;
  224.                  FileNameLen : Byte;
  225.                  FileName    : Array[1..12] of Char;
  226.                end;
  227.  
  228. Var LZH1     : LZHHead;
  229.  
  230. Procedure GET_LZH_ENTRY;
  231. begin
  232.   FillChar(LZH1,SizeOf(LZHHead),#0); FillChar (DT,SizeOf(DT),#0);
  233.   L := SizeOf(LZHHead);
  234.   Seek (F,C); BlockRead (F,BUFF,L,RES);
  235.   Move (BUFF[1],LZH1,L);
  236.   With LZH1 do
  237.     if HSize > 0 then
  238.       begin
  239.         Move (FileNameLen,SNAME,FileNameLen+1);
  240.         UnPackTime (Dos_DT,DT);
  241.         FSize := CompSize;
  242.       end
  243.     else QUIT := True
  244. end;  { GET_LZH_ENTRY }
  245.  
  246. Procedure DO_LZH (FN : String);
  247. begin
  248.   Assign (F,FN); Reset (F,1);
  249.   FSize := FileSize(F); C := 0; QUIT := False;
  250.   Repeat
  251.     GET_LZH_ENTRY;
  252.     if not QUIT then
  253.       begin
  254.         Inc (WPX); New(SW[WPX]);       { store Filename info in dynamic Array }
  255.         With SW[WPX]^ do
  256.           begin
  257.             FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+'    ',1,4)
  258.             SIZE := LZH1.UCompSize;
  259.             RType := 4; ANUM := ADX; VNUM := VDX; D_T := LZH1.Dos_DT;
  260.             ADD_CNAME;
  261.           end;
  262.         Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)
  263.       end;
  264.     Inc (C,FSize+LZH1.HSize+2)
  265.   Until QUIT;
  266.   Close (F);
  267. end;  { DO_LZH }
  268.